/*
 * Copyright (C) 2000-2005 Philips Electronics N.V.
 * 
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or 
 * (at your option) any later version.
 * 
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 * 
 * You should have received a copy of the GNU General Public License
 * along with this program; see the file gnu_license.txt.  If not, write to
 * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  
 * 
 */
#include <gmp.h>
#include <front/mem.h>
#include "cfrontPrint.h"
#include "eval.h"
#include "type.h"
#include "spectype.h"
#include "errors.h"
#include "platform.h"

/* Keep these static, their definition may differ per cfront root */
static Type size_t_type, wchar_t_type, ptrdiff_t_type;

Type char_type, short_type, int_type;
Type float_type, double_type;
Type enum_type;
Type void_type;
Type long_type_spec;
Type implicit_function_type;

static void compute_size_info (Type t, Bool *ok, Bool just_align);
static struct s_cfront_TraverseTable get_simple_decls;
static struct s_cfront_TraverseTable get_parameters;

/*
   Removed following #warning because I think it's solved now.
     warning To do: (possible) unsignedness of char is hard-coded, \
         make it more general.  Using SpecType for this will get you in a lot \
         of problems.
*/

/* ----------------------------------------------------------------------------
 * Don't copy internal types
 */
static IdType
copy_actions_Type (IdType me)
{
  if (is_internal_type(me)) return me;
  return NULL;
}

/* ----------------------------------------------------------------------------
 * Create an internal declarator
 */
declarator
internal_declarator (const char *name)
{
  Ident id = Create_Ident (name);
  declarator decl = Create_Id_Decl (no_srcinfo, id);
  
  declarator_scope(decl) = NULL;
  declarator_storage_class(decl) = Typedef;
  
  StoreBind (id, NULL, Bind_declarator_kind, decl, cfront_DefaultNameSpace,
             TRUE, FALSE, TRUE);
  /* Mark this node for ever so it will not be GC-ed */
  Mark_AST_node (decl, MAX_GENERATION, (void*)Traverse_void_declarator);
  return decl;
}

/* ----------------------------------------------------------------------------
 * Create an internal type
 */
Type
internal_type (const char *name, int size, int align, Bool undeclared)
{
  Ident      id = Create_Ident (name);
  declarator d = NULL;
  Type t;

  if (!undeclared) d = internal_declarator (name);

  t = Create_IdType (no_srcinfo, size, align, id, d);
  IdType_internal (t) = TRUE;
  
  if (d) {
    declarator_type (d) = t;
    Id_Decl_typedec (d) = t;
  }
  if (!undeclared) {
    StoreBind (id, NULL, 0, t, cfront_TypeNameSpace, FALSE, FALSE, TRUE);
  }
  return t;  
}

/* ----------------------------------------------------------------------------
 * Create an undeclared internal type (like size_t)
 */
static Type
undeclared_type (const char *name, int size, int align)
{
  Type t = internal_type (name, size, align, TRUE);
  IdType_std(t) = TRUE;
  return t;
}

/* ----------------------------------------------------------------------------
 * Create a standard type
 */
static Type
standard_type (const char *name, int size, int align)
{
  Type t = internal_type (name, size, align, FALSE);
  IdType_std(t) = TRUE;
  return t;
}

#define STD_TYPE(T) standard_type(#T,sizeof_##T,alignof_##T)

/* ----------------------------------------------------------------------------
 * Set sizeof and alignof basic type T to SIZE and ALIGN
 */
static void
set_size_info (Type t, size_t size, size_t align)
{
  Type_size (t) = size;
  Type_align (t) = align;
}

/* ----------------------------------------------------------------------------
 * Initialize the standard types
 */
void
initialize_types(void)
{
  char_type         = standard_type ("char", 1, 1);
  short_type        = STD_TYPE(short);
  int_type          = STD_TYPE(int);
  long_type_spec    = standard_type ("long", sizeof_long_int, alignof_long_int);
  enum_type         = int_type;
#warning Todo: move enum_type setting to platform.[ch]
  
  float_type        = STD_TYPE(float);
  double_type       = STD_TYPE(double);

  /* size=1 because a void* acts the same as a char* */
  /* I'm afraid this is not true; void* is not a pointer to object type and is hence not suited for pointer arithmetic. */
  /* Probably better to set the size to zero. */
  void_type         = standard_type ("void", 1, 1);  

  implicit_function_type = Create_FunctionType (no_srcinfo, SIZEOF_PTR,
                                                ALIGNOF_PTR, int_type,
                                                NULL, NULL);
  ptrdiff_t_type    = undeclared_type ("ptrdiff_t", sizeof_ptrdiff_t, alignof_ptrdiff_t);
  size_t_type       = undeclared_type ("size_t",    sizeof_size_t, alignof_size_t);
  wchar_t_type      = undeclared_type ("wchar_t",   sizeof_wchar_t, alignof_wchar_t);

  cfront_copy_actions.action_Type [PRE_ACTION] = (void*)copy_actions_Type;
}

/* ----------------------------------------------------------------------------
 * Get the size_t, wchar_t, or ptrdiff_t  definition at position NUM
 * and in SCOPE 
 */
static Type
get_std_type(int num, Scope scope, char *name)
{
  Bind bind;
  declarator d;
  
  bind = RetrieveBind (Create_Ident (name), scope, num,
                       DefaultNameSpace, Bind_cfront_declarator_kind);
  if (!bind) return NULL;
  d = Bind_object (bind);
  assert (declarator_tag (d) == Id_Decl_kind);
  return declarator_type (d);
}

Type
get_size_t(int num, Scope scope)
{
  Type t = get_std_type (num, scope, "size_t");
  if (!t) t = size_t_type;
  return t;
}

Type
get_wchar_t(int num, Scope scope)
{
  Type t = get_std_type (num, scope, "wchar_t");
  if (!t) t = wchar_t_type;
  return t;
}

Type
get_ptrdiff_t(int num, Scope scope)
{
  Type t = get_std_type (num, scope, "ptrdiff_t");
  if (!t) t = ptrdiff_t_type;
  return t;
}

Type defined_type(Type t, int num, Scope scope)
{
  if (t == get_ptrdiff_t(num, scope)) return int_type;
  if (t == get_wchar_t  (num, scope)) return int_type;
  if (t == get_size_t   (num, scope)) return make_unsigned_int();
  return t;
}


/* ----------------------------------------------------------------------------
 * TRUE if AS is identical to BS
 */
static Bool
identical_enum_members (List_declarator as, List_declarator bs)
{
  enumerator a, b;
  
  if(!as || !bs) return as==bs;
  a = List_declarator_data (as);
  b = List_declarator_data (bs);
  if (enumerator_id (a) != enumerator_id (b)) return FALSE;
  if ((enumerator_c (a) || enumerator_c (b)) &&
      !EqualIntExprs (enumerator_c (a), enumerator_c (b))) {
    return FALSE;
  }
  return identical_enum_members (List_declarator_next (as),
                                 List_declarator_next (bs));
}

/* ----------------------------------------------------------------------------
 * The recursion of compatible_types
 */
static Bool
rec_compatible_types(Type a, Type b, Bool separate_TU)
{
  CompatibleType_Memo memo = Create_CompatibleType_Memo(no_srcinfo, a, b,
                                                        separate_TU);
  return CompatibleType_Memo_busy (memo) || CompatibleType_Memo_r (memo);
}

/* ----------------------------------------------------------------------------
 * TRUE if AS is compatible to BS
 */
static Bool
compatible_simple_decls (List_SimpleDecl as, List_SimpleDecl bs,
                         Bool separate_TU)
{
  SimpleDecl a, b;
  
  if(!as || !bs) return as==bs;
  a = List_SimpleDecl_data (as);
  b = List_SimpleDecl_data (bs);
  if (SimpleDecl_id (a) != SimpleDecl_id (b)) return FALSE;
  if (!rec_compatible_types (SimpleDecl_type (a), SimpleDecl_type (b),
                             separate_TU)) {
    return FALSE;
  }
  return compatible_simple_decls (List_SimpleDecl_next (as),
                                  List_SimpleDecl_next (bs),
                                  separate_TU);
}

/* ----------------------------------------------------------------------------
 * TRUE if AS if compatible to BS
 */
static Bool
compatible_list_types (List_Type as, List_Type bs, Bool separate_TU)
{
  for (; as && bs;
       as = List_Type_next (as), bs = List_Type_next (bs)) {
    if (!rec_compatible_types (List_Type_data (as), List_Type_data (bs),
                               separate_TU)) {
      return FALSE;
    }
  }
  return as==bs;
}

/* ----------------------------------------------------------------------------
 * TRUE iff A and B are compatible types  (3.1.2.6)
 * Note: only valid during or after BU_typing
 */
static Bool
__compatible_types(Type a, Type b, Bool separate_TU)
{
  a = expanded_type (a);
  b = expanded_type (b);
  if (a==b) return TRUE;
  if (Type_tag(a)!=Type_tag(b)) {
    /* 3.5.2.2: Each enumerated type shall be compatible with an
       integer type; the choice of type is implementation-defined. */
    if (is_enum_type(a)) return b==enum_type;
    if (is_enum_type(b)) return a==enum_type;
    if (is_spectype (a) && !is_spectype(b)) {
      return ( rec_compatible_types (base_type (a), b, separate_TU) &&
               compatible_specs (a, NULL) );
    }
    if (!is_spectype (a) && is_spectype(b)) {
      return ( rec_compatible_types (a, base_type (b), separate_TU) &&
               compatible_specs (NULL, b) );
    }
    return FALSE;
  }
  /* Same type tag */
  switch (Type_tag(a)) {
  case IdType_kind:
    if (is_internal_type(a) && is_internal_type(b)) return FALSE;
    if (!is_internal_type(a)) a = declarator_type (IdType_decl(a));
    if (!is_internal_type(b)) b = declarator_type (IdType_decl(b));
    return rec_compatible_types (a, b, separate_TU);
  case PointerType_kind:   /* 3.5.4.1 */
    return rec_compatible_types (dereference_type(a), dereference_type(b),
                             separate_TU);
  case ArrayType_kind:     /* 3.5.4.2 */
    /* Pre: Array sizes have been computed for A and B */
    if (ArrayType_size (a)>0 && ArrayType_size (b)>0) {
      if (ArrayType_size (a) != ArrayType_size (b)) return FALSE;
    }
    return rec_compatible_types (dereference_type(a), dereference_type(b),
                             separate_TU);
  case FunctionType_kind:  /* 3.5.4.3 */
#warning To do: compatible function types (3.5.4.3)
    if (!rec_compatible_types (function_result_type (a),
                               function_result_type (b),
                               separate_TU)) {
      return FALSE;
    }
    if (!FunctionType_arg_types(a)) {
      return TRUE;
    } 
    if (!FunctionType_arg_types(b)) {
      return TRUE;
    } 
    return compatible_list_types (FunctionType_arg_types(a),
                                  FunctionType_arg_types(b),
                                  separate_TU);
  case StructType_kind:    /* 3.1.2.6 */
  case UnionType_kind:     /* 3.1.2.6 */
    /* 3.5.2.1: The presence of a struct-declaration-list in a
       struct-or-union-specifier declares a new type within a
       translation unit. */
    if (!separate_TU) return AggrType_atag(a) == AggrType_atag(b);
    /* union members are sorted by name */
    return compatible_simple_decls (AggrType_mems (a), AggrType_mems (b),
                                    TRUE);
  case EnumType_kind:      /* 3.1.2.6 */
    /* 3.1.2.6 only applies to other translation units */
    if (!separate_TU) return EnumType_etag(a) == EnumType_etag(b);
    return identical_enum_members (EnumType_members (a), EnumType_members (b));
  case SpecType_kind:
    return ( rec_compatible_types (expanded_base_type (a),
                                   expanded_base_type (b),
                                   separate_TU) &&
             compatible_specs (a, b) );
  case EllipsisType_kind:
    return TRUE;
  }
  abort();
}


Bool
_compatible_types (CompatibleType_Memo me)
{
  Bool r = __compatible_types (CompatibleType_Memo_a(me),
                               CompatibleType_Memo_b(me),
                               CompatibleType_Memo_separate_TU(me));
  CompatibleType_Memo_busy (me) = FALSE;
  return r;
}

Bool
compatible_types(Type a, Type b)
{
  return rec_compatible_types (a, b, FALSE);
}

Bool
compatible_types_separate_TU(Type a, Type b)
{
  return rec_compatible_types (a, b, TRUE);
}

/* ----------------------------------------------------------------------------
 * Holds iff AP and BP are pointers to qualified or unqualified
 * versions of compatible types
 */
Bool
ptrs_to_compatible_types(Type ap, Type bp)
{
  Type a, b;

  if (!is_derived_declarator_type (ap) ||
      !is_derived_declarator_type (bp)) return FALSE;
  a = unqualified_type (dereference_type (ap));
  b = unqualified_type (dereference_type (bp));
  return compatible_types (a, b);
}

/* ----------------------------------------------------------------------------
 * Insert singleton SINGLE into sorted list TAIL
 */
static List_SimpleDecl
insert_simple_decl (List_SimpleDecl single, List_SimpleDecl tail)
{
  Ident a, b;
  if (!tail) return single;
  a = SimpleDecl_id (List_SimpleDecl_data (single));
  b = SimpleDecl_id (List_SimpleDecl_data (tail));
  if (strcmp (Ident_name (a), Ident_name (b)) <= 0) {
    List_SimpleDecl_next (single) = tail;
    return single;
  } else {
    List_SimpleDecl_next (tail) =
      insert_simple_decl (single, List_SimpleDecl_next (tail));
    return tail;
  }
}

/* ----------------------------------------------------------------------------
 * Sort list DS
 */
static List_SimpleDecl
sort_simple_decls (List_SimpleDecl ds)
{
  List_SimpleDecl tail;
  
  if (!ds) return NULL;
  tail = List_SimpleDecl_next (ds);
  if (!tail) return ds;
  tail = sort_simple_decls (tail);
  List_SimpleDecl_next (ds) = NULL;
  return insert_simple_decl (ds, tail);
}

/* ----------------------------------------------------------------------------
 * Create simple declarations for struct or union members
 */
static List_SimpleDecl
get_simple_decls_Id_Decl (Id_Decl me, List_SimpleDecl ds)
{
  SimpleDecl d = Create_SimpleDecl (declarator_src_info (me),
                                    declarator_type (me),
                                    Id_Decl_id (me));
  FRONT_APPEND_NODE(ds, d);
  return ds;
}

/* ----------------------------------------------------------------------------
 * Get the types of function parameter
 */
static List_Type
get_parameters_ellipsis_declarator (ellipsis_declarator me, List_Type ts)
{
  FRONT_APPEND_NODE(ts, declarator_type (me));
  return ts;
}

static List_Type
get_parameters_Par_Id_Decl (Par_Id_Decl me, List_Type ts)
{
  FRONT_APPEND_NODE(ts, declarator_type (me));
  return ts;
}

static List_Type
get_parameters_Id_Decl (Id_Decl me, List_Type ts)
{
  FRONT_APPEND_NODE(ts, declarator_type (me));
  return ts;
}

/* ----------------------------------------------------------------------------
 * Initialize traverse tables
 */
static void
init_traversals(void)
{
  static Bool done = FALSE;
  if (done) return;
  done = TRUE;

  /* Used in decorate_type: */
  get_simple_decls.skip_children_declaration_specifiers = TRUE;
  get_simple_decls.skip_children_parameter_list         = TRUE;
  get_simple_decls.skip_children_StructDef              = TRUE;
  get_simple_decls.skip_children_UnionDef               = TRUE;
  get_simple_decls.skip_children_type_name              = TRUE;
  get_simple_decls.action_Id_Decl [PRE_ACTION]          = (void*)get_simple_decls_Id_Decl;
  
  get_parameters.action_Par_Id_Decl [PRE_ACTION]         = (void*)get_parameters_Par_Id_Decl;
  get_parameters.action_Id_Decl [PRE_ACTION]             = (void*)get_parameters_Id_Decl;
  get_parameters.action_ellipsis_declarator [PRE_ACTION] = (void*)get_parameters_ellipsis_declarator;
  get_parameters.skip_children_declaration_specifiers = TRUE;
  get_parameters.skip_children_parameter_list      = TRUE;
  get_parameters.skip_children_StructDef           = TRUE;
  get_parameters.skip_children_UnionDef            = TRUE;
  get_parameters.skip_children_type_name           = TRUE;
}

/* ----------------------------------------------------------------------------
 * Fill in function argument types, and struct and union members
 */
Type
decorate_type (Type t)
{
  if (!t) return NULL;
  init_traversals ();
  
  switch (Type_tag (t)) {
  case IdType_kind:
  case PointerType_kind:
  case ArrayType_kind:
  case EnumType_kind:
  case EllipsisType_kind:
     break;
  case FunctionType_kind:
    if (FunctionType_arg_types (t)) break;
    FunctionType_arg_types (t) =
      Traverse_List_declaration (FunctionType_args (t), &get_parameters, NULL);
    break;
  case StructType_kind:
    if (AggrType_mems (t)) break;
    AggrType_mems (t) =
      Traverse_List_declaration (AggrType_members (t), &get_simple_decls, NULL);
    break;
  case UnionType_kind:
    if (AggrType_mems (t)) break;
    AggrType_mems (t) = 
      Traverse_List_declaration (AggrType_members (t), &get_simple_decls, NULL);
    if (AggrType_mems (t)) {
      AggrType_member1 (t) = List_SimpleDecl_data (AggrType_mems (t));
    }
    AggrType_mems (t) = sort_simple_decls (AggrType_mems (t));
    break;
  case SpecType_kind:
    SpecType_base (t) = decorate_type (SpecType_base (t));
    break;
  }
  return t;
}

/* ----------------------------------------------------------------------------
 * Perform integral promotion on T.
 */
Type
integral_promoted_type(Type t)
{
  Type r = int_type;

  assert (is_integral_type (t));
  if (is_long_long_type (t) ||
      is_long_int_type (t) ||
      is_enum_type (t)) {
    return t;
  }
  if (is_unsigned_type (t)) r = make_unsigned (r);
  return r;
}

/* ----------------------------------------------------------------------------
 * Perform the usual arithmetic conversions on type AT and BT
 */
Type
arithmetic_converted_type(Type at, Type bt)
{
  if (user_arithmetic_conversion) {
    Type t = user_arithmetic_conversion (at, bt);
    if (t) return t;
  }
  
  if (is_long_double_type (at)) return at;
  if (is_long_double_type (bt)) return bt;
  if (is_double_type (at)) return at;
  if (is_double_type (bt)) return bt;
  if (is_float_type (at)) return at;
  if (is_float_type (bt)) return bt;
  
  at = integral_promoted_type (at);
  bt = integral_promoted_type (bt);

  if (is_unsigned_type(at) && is_long_int_type(at)) return at;
  if (is_unsigned_type(bt) && is_long_int_type(bt)) return bt;

  if (is_long_int_type (at) && is_unsigned_type (bt)) {
    if (unsigned_int_fits_long) return at;
    else                        return make_unsigned_long_int();
  }
  if (is_long_int_type (bt) && is_unsigned_type (at)) {
    if (unsigned_int_fits_long) return bt;
    else                        return make_unsigned_long_int();
  }
  
  if (is_long_int_type (at)) return at;
  if (is_long_int_type (bt)) return bt;
  /* both AT and BT are integers */
  if (is_unsigned_type (at)) return at;
  if (is_unsigned_type (bt)) return bt;
  
  return int_type;
}

/* ----------------------------------------------------------------------------
 * Shallow copy of T
 */
Type
copy_type(Type t)
{
  Type r = fe_malloc(sizeof(*r));
  *r = *t;
  return r;
}

/* ----------------------------------------------------------------------------
 * Number of bits in integer type T
 */
static size_t
Type_bits(Type t)
{
  return Type_size(t)*bits_per_char;
}

/* ----------------------------------------------------------------------------
 * TRUE iff integer S fits into type T
 */
Bool
constant_fits(AP_Integer val, Type t)
{
  size_t b = mpz_sizeinbase (*val, 2);
  return 0<b && b<=Type_bits(t);
}

/* ----------------------------------------------------------------------------
 * Get struct or union member M of T
 */
SimpleDecl
struct_member (Type t, Ident m)
{
  List_SimpleDecl ms;
  Type s = expanded_base_type(t);
  
  assert (is_structured_type(s));

  for (ms = AggrType_mems (s); ms; ms = List_SimpleDecl_next (ms)) {
    SimpleDecl d = List_SimpleDecl_data (ms);
    if (SimpleDecl_id (d) == m) return d;
  }
  return NULL;
}

/* ----------------------------------------------------------------------------
 * Get struct or union member offset of M in T
 */
size_t
member_offset (Type t, Ident m)
{
  Bool ok;
  SimpleDecl mem = NULL;
  List_SimpleDecl ms;
  Type s = expanded_base_type(t);
  
  assert (is_structured_type(s));
  if (is_union_type (t)) return 0;
  compute_size_info (t, &ok, FALSE);
  assert (ok);

  for (ms = AggrType_mems (s); ms; ms = List_SimpleDecl_next (ms)) {
    mem = List_SimpleDecl_data (ms);
    if (SimpleDecl_id (mem) == m) break;
  }
  assert (ms);
  return SimpleDecl_offset (mem);
}

/* ----------------------------------------------------------------------------
 * Create the composite type of A and B
 * ANSI 3.1.2.6
 * Pre: A and B are compatible types
 * Note: I've assumed that the composite will have all qualifiers of
 *   both types.  The reference does not specify this one way or the
 *   other. 
 */
Type
composite_type (Type a, Type b)
{
  Type r;
  Type ab = expanded_base_type (a);
  Type bb = expanded_base_type (b);
  int size  = Type_size (ab);
  int align = Type_align(ab);
  
  if (is_array_type(ab)) {
    expression a_size = ArrayType_a_size(ab);
    
    if (ArrayType_a_size(bb)) {
      a_size = ArrayType_a_size(bb);
      size = Type_size(bb);
      align = Type_align(bb);
    }
    r = Create_ArrayType (Type_src_info(ab), size, align, a_size,
                          composite_type (ArrayType_element (ab),
                                          ArrayType_element (bb)));
  } else if (is_function_type(ab)) {
    List_Type as, bs, cs;
    
    decorate_type (ab);
    decorate_type (bb);
    if (!FunctionType_arg_types (ab)) {
      cs = Deep_copy_types (FunctionType_arg_types (bb));
    } else if (!FunctionType_arg_types (bb)) {
      cs = Deep_copy_types (FunctionType_arg_types (ab));
    } else {       
      size = Type_size(bb);
      align = Type_align(bb);
      cs = NULL;
      for (as = FunctionType_arg_types(ab), bs = FunctionType_arg_types(bb);
           as;
           as = List_Type_next (as), bs = List_Type_next (bs)) {
        Type ap = List_Type_data (as);
        Type bp = List_Type_data (bs);
        FRONT_APPEND_NODE(cs, composite_type (ap, bp));
      }
    }
    r = Create_FunctionType (Type_src_info (ab), size, align,
                             composite_type (FunctionType_result (ab),
                                             FunctionType_result (bb)),
                             NULL, cs);
  } else {
    /* otherwise they are compatible, pick one */
    return a;
  }
  return copy_specs (r, both_specs (a, b));
}

/* ----------------------------------------------------------------------------
 * Expands T to its typedef it is one
 */
Type
expanded_type (Type t)
{
  declarator d;
  if (!t || Type_tag(t)!=IdType_kind || is_internal_type (t)) {
    return t;
  }
  d = IdType_decl (t);
  if (!d) return t;
  return expanded_type (declarator_type (d));
}

Type
expanded_base_type (Type t)
{
  Type base = expanded_type(t);
  while (is_spectype(base)) {
    base = expanded_type (base_type (base));
  }
  return base;
}

/* ----------------------------------------------------------------------------
 * The type from which T is derived (3.1.2.5)
 */
Type
derived_type (Type t)
{
  Type base = expanded_base_type (t);

  switch (Type_tag(base)) {
  case PointerType_kind:  return PointerType_target(t);
  case ArrayType_kind:    return ArrayType_element(t);
  case FunctionType_kind: return FunctionType_result(t);
  default:
    abort();
  }
}

/*
 *   QUALIFIER MANIPULATION
 *
 * known qualifiers: const, volatile
 */

Type
unqualified_type(Type t)
{
  Type u;
  /* 3.1.2.5:  A derived type is not qualified by the qualifiers of
     the type from which it is derived */
  if (!is_spectype(t)) return t;
  u = clear_const (clear_volatile (copy_type (t)));
  if (user_unqualify_attribute) {
    u = type_remove_attributes (u);
    u = type_add_attributes (u, user_unqualify_attribute (type_attributes (t)));
  }
  return u;
}

/* A with qualifiers from A and B */
Type
copy_qualifiers (Type a, Type b)
{
  if (is_const_type(b))    a = make_const (a);
  if (is_volatile_type(b)) a = make_volatile (a);
  if (user_attribute_qualifiers) {
    a = type_add_attributes (a, user_attribute_qualifiers(type_attributes (b)));
  }
  return a;
}


/*
 *   QUALIFIER PREDICATES
 */

/* qual.a <= qual.b */
Bool
has_qualifier_subset(Type a, Type b)
{
  if (is_const_type (a) &&    !is_const_type(b)) return FALSE;
  if (is_volatile_type (a) && !is_volatile_type(b)) return FALSE;
  if (user_attribute_has_subset) {
    return user_attribute_has_subset (type_attributes(a), type_attributes(b));
  }
  return TRUE;
}

/*
 *   TYPE MANIPULATION 
 */

Type
dereference_type (Type t)
{
  Type base = expanded_base_type(t);
  
  switch (Type_tag(base)) {
  case PointerType_kind:  return PointerType_target (base);
  case ArrayType_kind:    return ArrayType_element (base);
  case FunctionType_kind: return base;
  default:
    abort();
  }
}

Type
pointer_to_type (Type t)
{
  assert (!is_bitfield_type(t));
  return Create_PointerType (no_srcinfo, sizeof_void_pointer,
                             sizeof_void_pointer, t);
}

Type
function_result_type(Type t)
{
  assert (is_function_type(t));
  return FunctionType_result (expanded_base_type (t));
}

List_Type
function_arg_types(Type t)
{
  assert (is_function_type(t));
  return FunctionType_arg_types (expanded_base_type (t));
}

Type
pointer_promote(Type t)
{
  if (is_array_type (t))    return pointer_to_type (dereference_type (t));
  if (is_function_type (t)) return pointer_to_type (t);
  return t;
}


/*
 *   STANDARD TYPE CREATION
 */
Type
make_long_int (void)
{
  Type t = make_long (int_type);
  set_size_info (t, sizeof_long_int, alignof_long_int);
  return t;
}

Type
make_long_long_int (void)
{
  Type t = make_long_long (int_type);
  set_size_info (t, sizeof_long_long, alignof_long_long);
  return t;
}

Type
make_long_double (void)
{
  Type t = make_long (double_type);
  set_size_info (t, sizeof_long_double, alignof_long_double);
  return t;
}

Type
make_unsigned_char (void)
{
  return make_unsigned (char_type);
}

Type
make_unsigned_short (void)
{
  return make_unsigned (short_type);
}

Type
make_unsigned_int (void)
{
  return make_unsigned (int_type);
}

Type
make_unsigned_long_int (void)
{
  return make_unsigned (make_long_int());
}

Type
make_unsigned_long_long_int (void)
{
  return make_unsigned (make_long_long_int());
}

Type
make_char_pointer (void)
{
  return pointer_to_type (char_type);
}

Type
make_void_pointer (void)
{
  Type t = pointer_to_type (void_type);
  set_size_info (t, sizeof_void_pointer, alignof_void_pointer);
  return t;
}


/*
 *   TYPE CLASSIFICATION  (3.1.2.5)
 */

Bool
is_object_type(Type t)
{
  if (!t) return FALSE;
  return !is_function_type(t) && !is_incomplete_type(t);
  
}

Bool
is_incomplete_type(Type t)
{
  Bool ok;

  if (!t) return FALSE;
  if (is_void_type (t)) return TRUE;
  if (is_function_type (t)) return FALSE;
  sizeof_type (t, &ok);
  return !ok;
}

Bool
is_integer_type(Type t)
{
  Type base = expanded_base_type (t);
  if (base==char_type)         return TRUE;
  if (base==int_type)          return TRUE;
  if (base==short_type)        return TRUE;
  if (is_long_int_type(base))  return TRUE;
  if (base==size_t_type)       return TRUE;
  if (base==wchar_t_type)      return TRUE;
  if (base==ptrdiff_t_type)    return TRUE;
  return FALSE;
}

Bool
is_signed_type(Type t)
{
  if (is_enum_type (t)) return TRUE;
  if (!is_integer_type(t)) return FALSE;
  return !is_unsigned_type (t);
}

Bool
is_unsigned_type(Type t)
{
  if (!is_integer_type(t)) return FALSE;
  if (t==char_type && char_is_unsigned) return TRUE;
  if (t==size_t_type) return TRUE;
  if (!is_spectype(t)) {
    Type u = expanded_type(t);
    return u != t && is_unsigned_type (u);
  }
  return ( SpecType_is_unsigned(t) ||
           is_unsigned_type (expanded_type (base_type (t))) );
}

/*
   For testing bit field types to have no signed/unsigned specifier.
   In C90 bit fields must be qualified or unqualified versions of plain,
   signed or unsigned int; in C99 also _Bool and implementation-defined
   types are allowed. We will allow all integral types here.
*/

Bool
is_plain_integral_type(Type t)
{
  return is_plain_type(t) && is_integral_type(t);
}

Bool
is_plain_type(Type t)
{
  if (is_internal_type (t)) return TRUE;
  switch (Type_tag (t))
  {
    case SpecType_kind:
    {
      if (SpecType_is_signed (t)) return FALSE;
      if (SpecType_is_unsigned (t)) return FALSE;
      if (SpecType_base (t)) return is_plain_type (SpecType_base (t));
    }
    case IdType_kind:
    {
      declarator d = IdType_decl (t);
      return d ? is_plain_type (declarator_type (d)) : TRUE;
    }
    default: ;
  }
  return TRUE;
}

Bool
is_long_variant(Type t)
{
  if (!is_spectype(t)) {
    Type u = expanded_type(t);
    return u != t && is_long_variant (u);
  }
  return ( SpecType_is_long(t)==1 ||
           is_long_variant (expanded_type (base_type (t))) );
}

Bool
is_long_long_variant(Type t)
{
  if (!is_spectype(t)) {
    Type u = expanded_type(t);
    return u != t && is_long_long_variant (u);
  }
  return ( SpecType_is_long(t)==2 ||
           is_long_long_variant (expanded_type (base_type (t))) );
}

Bool
is_enum_type(Type t)
{
  Type base = expanded_base_type (t);
  return base && Type_tag(base)==EnumType_kind;
}

Bool
is_void_type(Type t)
{
  Type base = expanded_base_type (t);
  return base && base==void_type;
}

Bool
is_char_type(Type t)
{
  Type base = expanded_base_type (t);
  return base && base==char_type;
}

Bool
is_short_type(Type t)
{
  Type base = expanded_base_type (t);
  return base && base==short_type;
}

Bool
is_int_type(Type t)
{
  Type base = expanded_base_type (t);
  return base && base==int_type;
}

Bool
is_float_type(Type t)
{
  Type base = expanded_base_type (t);
  return base && base==float_type;
}

Bool
is_double_type(Type t)
{
  Type base = expanded_base_type (t);
  return base && base==double_type;
}

Bool
is_integral_type(Type t)
{
  return is_integer_type(t) || is_enum_type (t);
}

Bool
is_floating_type(Type t)
{
  Type base = expanded_base_type (t);
  if (base==float_type)  return TRUE;
  if (base==double_type) return TRUE;
  return is_long_double_type (base);
}

Bool
is_basic_type(Type t)
{
  Type base = expanded_base_type (t);
  if (base==char_type)         return TRUE;
  if (base==short_type)        return TRUE;
  if (base==int_type)          return TRUE;
  if (is_long_int_type(base))  return TRUE;
  if (base==float_type)        return TRUE;
  if (base==double_type)       return TRUE;
  return is_long_double_type (base);
}

Bool
is_arithmetic_type(Type t)
{
  return is_integral_type(t) || is_floating_type(t);
}

Bool
is_pointer_type(Type t)
{
  Type base = expanded_base_type (t);
  return base && Type_tag(base)==PointerType_kind;
}


Bool
is_scalar_type(Type t)
{
  return is_arithmetic_type(t) || is_pointer_type(t);
}

Bool
is_struct_type (Type t)
{
  Type base = expanded_base_type(t);
  return base && Type_tag(base)==StructType_kind;
}

Bool
is_union_type (Type t)
{
  Type base = expanded_base_type(t);
  return base && Type_tag(base)==UnionType_kind;
}

Bool
is_structured_type (Type t)
{
  return is_struct_type(t) || is_union_type(t);
}

Bool
is_array_type (Type t)
{
  Type base = expanded_base_type(t);
  return base && Type_tag(base)==ArrayType_kind;
}

Bool
is_aggregate_type (Type t)
{
  return is_struct_type(t) || is_array_type(t);
}

Bool
is_function_type (Type t)
{
  Type base = expanded_base_type(t);
  return base && Type_tag(base)==FunctionType_kind;
}

Bool
is_derived_type(Type t)
{
  return ( is_pointer_type(t) ||
           is_struct_type(t) ||
           is_union_type(t) ||
           is_array_type(t) ||
           is_function_type(t) );
}

Bool
is_derived_declarator_type(Type t)
{
  return is_pointer_type(t) || is_array_type(t) || is_function_type(t);
}

/*
 *   TYPE PREDICATES
 */

Bool
is_ellipsis_type (Type t)
{
  return t && Type_tag (t) == EllipsisType_kind;
}

Bool
is_void_pointer_type (Type t)
{
  return is_pointer_type(t) && is_void_type(dereference_type(t));
}

Bool
is_bitfield_type (Type t)
{
  return is_spectype(t) && SpecType_is_bit_field(t);
}

Bool
is_const_type (Type t)
{
  if (is_array_type (t)) return is_const_type (ArrayType_element (t));
  if (!is_spectype(t)) return FALSE;
  return ( SpecType_is_const(t) ||
           is_const_type (expanded_type (base_type (t))) );
}

Bool
is_volatile_type (Type t)
{
  if (is_array_type (t)) return is_volatile_type (ArrayType_element (t));
  if (!is_spectype(t)) return FALSE;
  return ( SpecType_is_volatile(t) ||
           is_volatile_type (expanded_type (base_type (t))) );
}

Bool
is_long_int_type (Type t)
{
  return is_long_variant(t) && is_int_type(t);
}

Bool
is_long_long_type (Type t)
{
  return is_long_long_variant(t) && is_int_type(t);;
}

Bool
is_long_double_type (Type t)
{
  return is_long_variant(t) && is_double_type(t);
}

Bool
is_string_type (Type t)
{
  Type u;
  
  if (!is_pointer_type (t) &&
      !is_array_type (t)) {
    return FALSE;
  }
  u = dereference_type (t);
  return ( expanded_base_type(u)==char_type ||
           expanded_base_type(u)==wchar_t_type );
}

Bool
is_internal_type (Type t)
{
  return t && Type_tag(t)==IdType_kind && (IdType_internal(t));
}

Bool
is_spectype(Type t)
{
  return t && Type_tag(t)==SpecType_kind;
}

Bool
is_function_pointer_type (Type t)
{
  if (!is_pointer_type (t)) return FALSE;
  return is_function_type (dereference_type (t));
}



/*
 *   TYPE SIZE, ALIGNMENT, AND RANGE
 */


int
ArrayType_size (Type t)
{
  AP_Integer v;
  
  assert (Type_tag (t) == ArrayType_kind);
  if (ArrayType__size (t)) return ArrayType__size (t);
  if (!ArrayType_a_size (t)) return -1;
  v = EvalIntExpr (ArrayType_a_size (t));
  if (!v) {
    if (!variable_length_arrays_allowed) {
      integral_expression_required (ArrayType_a_size (t));
    }
    return 0;
  } else {
    if (!mpz_fits_ulong_p (*v)) {
      char *string;
      gmp_asprintf(&string, "%Zd", *v);
      if ( mpz_sgn(*v) < 0 )
	array_with_negative_size (ArrayType_a_size(t), string);
      else
        array_too_large (ArrayType_a_size (t), string, (unsigned long long)ULONG_MAX);
      free(string);
      return 0;
    } else {
      ArrayType__size (t) = mpz_get_ui (*v);
      if (ArrayType__size (t)<=0) {
        array_with_negative_size (ArrayType_a_size (t));
      } 
    }
  }
  return ArrayType__size (t);
}

/* ----------------------------------------------------------------------------
 * Compute the size information of the union T
 */
static void
union_size_info (Type t, Bool *ok)
{
  List_SimpleDecl ds;
  Bool valid = TRUE;
  size_t align, size, result = 0, maxalign = 0;

  for (ds = AggrType_mems (t); ds; ds = List_SimpleDecl_next (ds)) {
    SimpleDecl d = List_SimpleDecl_data (ds);
    Type u = SimpleDecl_type (d);

    SimpleDecl_offset (d) = result;
    compute_size_info (u, &valid, FALSE);
    if (!valid) break;
    size  = Type_size (u);
    align = Type_align (u);
    if (result < size)    result = size;
    if (maxalign < align) maxalign = align;
  }

  if (ok) *ok = valid;
  if (valid) {
    Type_size (t)  = result;
    Type_align (t) = maxalign;
  }
}

static size_t
align_to (size_t p, size_t align)
{
  assert (align>0);
  return p+((align-p%align)%align);
}

/* ----------------------------------------------------------------------------
 * Compute the size information of the struct T
 */
static void
struct_size_info (Type t, Bool *ok)
{
  List_SimpleDecl ds;
  Bool valid;
  size_t align, result = 0, maxalign = 1;

  valid = (AggrType_mems (t)!=NULL || AggrType_defined (t));
  for (ds = AggrType_mems (t); ds; ds = List_SimpleDecl_next (ds)) {
    SimpleDecl d = List_SimpleDecl_data (ds);
    Type u = SimpleDecl_type (d);
    
    SimpleDecl_offset (d) = result;
    compute_size_info (u, &valid, FALSE);
    if (!valid) break;
    align = Type_align (u);
    result = align_to (result, align);
    result += Type_size (u);
    if (maxalign < align) maxalign = align;
  }

  if (ok) *ok = valid;
  if (valid) {
    Type_size (t)  = align_to (result, maxalign);
    Type_align (t) = maxalign;
  }
}

/* ----------------------------------------------------------------------------
 * Compute the size and alignment of type T
 * Assumptions:
 * 1. There will be no padding for other reasons than alignment;
 * 2. Structs and Unions have the alignment of the largest member;
 * 3. For basic types the alignment is equal to its size
 */
static void
compute_size_info (Type t, Bool *ok, Bool just_align)
{
  Type u;
  size_t s, a, e;
  
  if (Type_size (t) && Type_align(t)) {
    if (ok) *ok = TRUE;
    return;
  }
  if (ok) *ok = FALSE;
  switch (Type_tag (t)) {
  case IdType_kind:
    if (!IdType_decl (t)) return;
    u = declarator_type (IdType_decl (t));
    compute_size_info (u, ok, just_align);
    s = Type_size (u);
    a = Type_align (u);
    break;
  case PointerType_kind:
  case FunctionType_kind:
    s = a = SIZEOF_PTR;
    if (ok) *ok = TRUE;
    break;
  case ArrayType_kind:
    if (!just_align && ArrayType_size (t)<0) return;
    compute_size_info (ArrayType_element (t), ok, just_align);
    e = sizeof_type (ArrayType_element (t), ok);
    s = ArrayType_size (t) * e;
    a = Type_align (ArrayType_element (t));
    break;
  case StructType_kind:
    struct_size_info (t, ok);
    return;
  case UnionType_kind:
    union_size_info (t, ok);
    return;
  case EnumType_kind:
    s = a = Type_size (int_type);
    if (ok) *ok = TRUE;
    break;
  case SpecType_kind:
    if (is_long_int_type (t)) {
      s = sizeof_long_int;
      a = alignof_long_int;
      if (ok) *ok = TRUE;
    } else if(is_long_long_type (t)) {
      s = sizeof_long_long;
      a = alignof_long_long;
      if (ok) *ok = TRUE;
    } else if(is_long_double_type (t)) {
      s = sizeof_long_double;
      a = alignof_long_double;
      if (ok) *ok = TRUE;
    } else {
      compute_size_info (SpecType_base (t), ok, just_align);
      s = Type_size  (SpecType_base (t));
      a = Type_align (SpecType_base (t));
    }
    break;
  case EllipsisType_kind:
    s = a = 0;
    break;
  }
  if (!just_align) Type_size  (t) = s;
  Type_align (t) = a;
}

/* ----------------------------------------------------------------------------
 * The size of T
 */
size_t
sizeof_type (Type t, Bool *ok)
{
  compute_size_info (t, ok, FALSE);
  return Type_size (t);
}

/* ----------------------------------------------------------------------------
 * The alignment of T
 */
size_t
alignof_type (Type t, Bool *ok)
{
  compute_size_info (t, ok, TRUE);
  return Type_align (t);
}

/* ----------------------------------------------------------------------------
 * Number of bits in T
 */
size_t
bits_of_type (Type t, Bool *ok)
{
  size_t r;
  r = sizeof_type (t, ok);
  return r * bits_per_char;
}


/*
 *   TYPE TEXTUALIZATION
 */

char *
Type_name (Type t, char *u)
{
  declaration d;
  if (!t) return Front_StrAllocf("<no type> %s",u);
  if (u) d = declare_variable (t, Create_Ident (u));
  else   d = declare_variable (t, NULL);
  return Text_declaration (d);
}

/*
 *   TYPE TRAVERSALS
 */

static void *
traverse_types (List_Type ts, void *arg, 
                void *visit(Type t, void *),
                Bool into(Type t, void *))
{
  while(ts) {
    arg = traverse_type (HEAD(ts), arg, visit, into);
    ts = TAIL(ts);
  }
  return arg;
}

static void *
traverse_simpledecls (List_SimpleDecl ds, void *arg,
                      void *visit(Type t, void *),
                      Bool into(Type t, void *))
{
  while(ds) {
    SimpleDecl d = HEAD(ds);
    arg = traverse_type (SimpleDecl_type(d), arg, visit, into);
    ds = TAIL(ds);
  }
  return arg;
}

void *
traverse_type (Type t, void *arg, 
               void *visit(Type t, void *),
               Bool into(Type t, void *))
{
  assert (visit);
  if (Type_generation(t)==1) return arg;
  Type_generation(t)++;
  arg = visit (t, arg);
  if (into && !into(t, arg)) return arg;
  switch (Type_tag(t)) {
  case EnumType_kind:
  case EllipsisType_kind:
  case IdType_kind:
    break;
  case PointerType_kind:
    arg = traverse_type (PointerType_target(t), arg, visit, into);
    break;
  case ArrayType_kind:
    arg = traverse_type (ArrayType_element(t), arg, visit, into);
    break;
  case FunctionType_kind:
    arg = traverse_type (FunctionType_result(t), arg, visit, into);
    arg = traverse_types (FunctionType_arg_types(t), arg, visit, into);
    break;
  case StructType_kind:
  case UnionType_kind:
    arg = traverse_simpledecls (AggrType_mems(t), arg, visit, into);
    break;
  case SpecType_kind:
    arg = traverse_type (SpecType_base (t), arg, visit, into);
    break;
  }
  Type_generation(t)--;
  return arg;
}

/*
 *   TYPE COPYING
 */

Type Deep_copy_type (Type t);
List_Type Deep_copy_types (List_Type l);

List_Type Deep_copy_types (List_Type l);
List_SimpleDecl Deep_copy_simpledecls (List_SimpleDecl l);

/*
   The trouble with copying types is that structs and unions may be recursive:
   - calling Traverse_copy_cfront_Type then leads to infinite recursion;
   - unless skip_children_AggrType is set, which leads to non-copied elements.
   Hence this dedicated function. It does not do any pre/post actions except
   where it seems to be necessary. Maybe we ought to dress it up with all the
   pre/post action stuff found in Traverse_copy_cfront_Type.
*/

static Type Deep_copy_gettype (Ident tag);
static void Deep_copy_settype (Ident tag, Type t);
static void Deep_copy_unsettype (Ident tag);
static Type Copy_type_node (Type t);

Type Deep_copy_type (Type t)
{
  Type n;
  Ident tag;

  if (!t) return t;
  /* Something unintelligible copied (slightly adapted) from cfront.c. */
  if (cfront_copy_actions.action_Type[PRE_ACTION] != NULL) {
    n = cfront_copy_actions.action_Type[PRE_ACTION](t, t);
    if (n) return n;
  }
  switch (Type_tag (t)) {

  /* Recurse unless we arrive at a cycle. */
  case StructType_kind:
  case UnionType_kind:
    tag = AggrType_atag(t);
    n = Deep_copy_gettype (tag);
    if (!n) {
      n = Copy_type_node(t);
      Deep_copy_settype (tag, n);
      AggrType_members(n) = Traverse_copy_List_declaration (AggrType_members(t), &cfront_copy_actions);
      AggrType_mems(n) = Deep_copy_simpledecls (AggrType_mems(t));
      AggrType_member1(n) = NULL;
      AggrType_defined(n) = FALSE;
      Deep_copy_unsettype (tag);
    }
    return n;

  /* Otherwise: recurse regardless. */
  case IdType_kind:
    n = Copy_type_node(t);
    IdType_decl(n) = Traverse_copy_declarator (IdType_decl(t), &cfront_copy_actions);
    return n;
  case PointerType_kind:
    n = Copy_type_node(t);
    PointerType_target(n) = Deep_copy_type (PointerType_target(t));
    return n;
  case ArrayType_kind:
    n = Copy_type_node(t);
    ArrayType_element(n) = Deep_copy_type (ArrayType_element(t));
    ArrayType_a_size(n) = Traverse_copy_expression (ArrayType_a_size(t), &cfront_copy_actions);
    return n;
  case FunctionType_kind:
    n = Copy_type_node(t);
    /* Can we have cycles of function types using function types? */
    FunctionType_result(n) = Deep_copy_type (FunctionType_result(t));
    FunctionType_arg_types(n) = Deep_copy_types (FunctionType_arg_types(t));
    return n;
  case EnumType_kind:
    n = Copy_type_node(t);
    EnumType_members(n) = Traverse_copy_List_declarator (EnumType_members(t), &cfront_copy_actions);
    return n;
  case SpecType_kind:
    n = Copy_type_node(t);
    SpecType_base(n) = Deep_copy_type (SpecType_base(t));
    SpecType_attr(n) = Traverse_copy_gnu_attr (SpecType_attr(t), &cfront_copy_actions);
    return n;
  case EllipsisType_kind:
    return Copy_type_node(t);
  }
  return NULL; /* Make the compiler happy. */
}

List_Type Deep_copy_types (List_Type l)
{
  if (!l) return NULL;
  else
  {
    Type t = List_Type_data(l);
    List_Type ts = List_Type_next(l);
    return (List_Type) Create_Front_List (Deep_copy_type (t), (Front_List) Deep_copy_types (ts));
  }
}

static Type Copy_type_node (Type t)
{
  Type new = (Type) fe_malloc (sizeof *new); *new = *t;
  Type_scope (new) = NULL;
  Type_generation (new) = 0;
  return new;
}

SimpleDecl Copy_simpledecl (SimpleDecl s)
{
  SimpleDecl new = (SimpleDecl) fe_malloc (sizeof *new); *new = *s;
  return new;
}

List_SimpleDecl Deep_copy_simpledecls (List_SimpleDecl l)
{
  if (!l) return NULL;
  else
  {
    SimpleDecl s = List_SimpleDecl_data(l);
    List_SimpleDecl ss = List_SimpleDecl_next(l);
    SimpleDecl n = Copy_simpledecl (s);
    SimpleDecl_type(n) = Deep_copy_type (SimpleDecl_type(n));
    return (List_SimpleDecl) Create_Front_List (n, (Front_List) Deep_copy_simpledecls (ss));
  }
}

/*
   Local, shallow database of (tag, type) tuples.
*/

typedef struct tag_type_t {
  struct tag_type_t *next;
  Ident tag;
  Type type;
} tag_type_t;

static tag_type_t *type_db = NULL;

static Type Deep_copy_gettype (Ident tag)
{
  tag_type_t *tt;
  for (tt = type_db; tt; tt = tt->next) {
    if (tt->tag == tag) return tt->type;
  }
  return NULL;
}

static void Deep_copy_settype (Ident tag, Type t)
{
  /* Pre: Deep_copy_gettype(tag) == NULL */

  tag_type_t *tt = fe_malloc (sizeof *tt);
  tt->next = type_db; type_db = tt;
  tt->tag = tag;
  tt->type = t;
}

static void Deep_copy_unsettype (Ident tag)
{
  /* Pre: Deep_copy_gettype(tag) != NULL */

  tag_type_t *tt, *p;
  for (p = NULL, tt = type_db; tt; p = tt, tt = tt->next) {
    if (tt->tag == tag) {
      if (p == NULL) type_db = tt->next; else p->next = tt->next;
      fe_free (tt);
      return;
    }
  }
  assert (tt); /* If we get here, tt is NULL and we bail out. */
}
